home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / language / embedded / m68k / 68343ffp.arc / IEFCALC.SA < prev    next >
Text File  |  1989-08-30  |  24KB  |  568 lines
  1.          TTL       IEEE FORMAT EQUIVALENT - DESK CALCULATOR DRIVER
  2. ***************************************
  3. * (C) COPYRIGHT 1981 BY MOTOROLA INC. *
  4. ***************************************
  5.  
  6. ******************************************
  7. * THIS IS A DESK-CALCULATOR DIAGNOSTIC   *
  8. * PROGRAM FOR THE MC68344 ROM IEEE FORMAT*
  9. * EQUIVALENT SUBROUTINES. THE INPUT      *
  10. * FORMAT IS NORMAL FORTRAN EXPRESSION    *
  11. * SYNTAX WITH AN OPTIONAL ASSIGNMENT     *
  12. * STATEMENT FOR THE ONLY VARIABLES "X"   *
  13. * AND "Y".  THE VARIABLES CAN BE USED IN *
  14. * EXPRESSIONS.  NO BLANKS ALLOWED.       *
  15. *                                        *
  16. * PLUS AND MINUS INIFINITY SYMBOLS ARE   *
  17. * >> AND <<.  A NAN IS REPRESENTED BY    *
  18. * TWO CONSECUTIVE PERIODS (..) OR BY NANX*
  19. * WHERE "X" IS A NUMBER FROM 1 TO 9 AND  *
  20. * IS PLACED INTO THE SIGNIFICAND PORTION *
  21. * OF THE NAN REPRESENTATION.             *
  22. *                                        *
  23. * A FLOATING POINT VALUE MAY BE ENTIRELY *
  24. * SPECIFIED IN HEXADECIMAL.  THIS IS DONE*
  25. * BY FOLLOWING A $ WITH EIGHT HEX DIGITS.*
  26. *                                        *
  27. * A SPECIAL DIADIC OPERATOR "?" PERFORMS *
  28. * A COMPARISON BETWEEN TWO VALUES REPORT-*
  29. * ING ALL VALID BRANCH CONDITIONS.       *
  30. *                                        *
  31. * ROUNDING (POWER OF TEN) IS SET WITH    *
  32. * AN "R=VALUE" STATEMENT (DEFAULT -100). *
  33. * FOR EXAMPLE, R=-1 ROUNDS TENTHS TO     *
  34. * UNITS.                                 *
  35. *                                        *
  36. *   EXAMPLES:      X=32.5                *
  37. *                                        *
  38. *                  Y                     *
  39. *                                        *
  40. *                  SQRT(5)*2E-3          *
  41. *                                        *
  42. *                  Y=X**.2+3.4           *
  43. *                                        *
  44. *                  10E-4*COS(Y-SIN(X))   *
  45. *                                        *
  46. *                  X=10E10+>>            *
  47. *                                        *
  48. *                  $7F80012F+ATAN(2)     *
  49. *                                        *
  50. *                  X=3.14159*..          *
  51. *                                        *
  52. *                  TEST(-0)              *
  53. *                                        *
  54. *                  3.14159*NAN1          *
  55. *                                        *
  56. *                  3.1?ABS(Y)            *
  57. *                                        *
  58. *  FUNCTIONS PROVIDED:        SQRT LOG   *
  59. *    EXP SIN COS TAN ATAN SINH COSH TANH *
  60. *    ABS NEG INT POWER (VIA ** OPERATOR) *
  61. *                                        *
  62. ******************************************
  63.          PAGE
  64.          OPT       FRS
  65.  
  66.          XREF      IEFAFP,IEFFPA,IEFSQRT,IEFARND,IEFFPI,IEFIFP SUBROUTINES
  67.          XREF      IEFADD,IEFSUB,IEFDIV,IEFMUL,IEFCMP,IEFTST,IEFABS,IEFNEG
  68.          XREF      IEFSIN,IEFCOS,IEFTAN,IEFEXP,IEFLOG,IEFPWR,IEFATAN
  69.          XREF      IEFSINH,IEFCOSH,IEFTANH
  70.  
  71.          XDEF      IEFCALC
  72.  
  73.          SECTION   2
  74.  
  75. ******************************************
  76. * IEEE FORMAT EQUIVALENT  CALCULATOR     *
  77. *         VERSION 1.1    5/17/81         *
  78. ******************************************
  79.  
  80. *
  81. * AT LABEL 'INPUT' THE STACK POINTS TO THE INPUT BUFFER
  82. *
  83. * DURING CALCULATIONS A6 HOLDS THE ABOVE VALUE FOR ERROR ABORTS
  84. *
  85.  
  86. EXPMSK   EQU.L     $7F800000 IEEE FORMAT EXPONENT MASK BITS
  87.  
  88. IEFCALC  LEA       STACK,SP  LOAD STACK
  89.  
  90.          BSR       MSG       GIVE BLANK LINE
  91.          DC.L      '        ' BEFORE HEADER
  92.          LEA       STRTM,A0  GIVE STARTUP MESSAGE
  93.          LEA       STRTME,A1 FOR STARTUP
  94.          BSR       PUT       PUT OUT FIRST LINE
  95.          LEA       STRTM2,A0 AND SECOND LINE
  96.          LEA       STRTM2E,A1 OF MESSAGE
  97.          BSR       PUT       CALL PUT ROUTINE
  98.          BSR       MSG       NOW BLANK LINE
  99.          DC.L      '       '
  100.          PAGE
  101.  
  102.          LEA       -80(SP),SP ALLOCATE BUFFER
  103.          MOVE.L    SP,A6     SETUP ERROR RECOVERY FRAME POINTER
  104.  
  105. INPUT    BSR       MSG       ISSUE PROMPT
  106.          DC.L      'READY'
  107.          MOVE.L    SP,A0     SETUP START ADDR
  108.          LEA       79(SP),A1 AND ENDING
  109.          BSR       GET       READ A LINE OF INPUT
  110.          MOVE.W    (SP),D0   GET FIRST TWO BYTES
  111. * TEST FOR 'QUIT' COMMAND
  112.          CMP.B     #'Q',(SP) ? "Q" COMMAND FOR QUIT
  113.          BEQ       QUIT
  114. * TEST FOR 'X=' ASSIGNMENT
  115.          LEA       2(SP),A0  DEFAULT ASSIGNMENT SCAN POSITION
  116.          CMP.W     #'X=',D0  ? ASSIGNMENT
  117.          BNE.S     NOTXASG   BRANCH IF NOT
  118.          BSR       INTRP     INTERPRET THE EXPRESSION
  119.          MOVE.L    D7,X      SAVE IN X
  120.          BRA.S     CALPRNT   PRINT OUT ITS VALUE
  121. * TEST FOR 'Y=' ASSIGNMENT
  122. NOTXASG  CMP.W     #'Y=',D0  ? Y ASSIGNMENT
  123.          BNE.S     NOTASG    BR NOT ASSIGNMENT
  124.          BSR       INTRP     INTERPRET THE EXPRESSION
  125.          MOVE.L    D7,Y      SAVE IN Y
  126.          BRA.S     CALPRNT    PRINT OUT ITS VALUE
  127. * TEST FOR 'R=' ROUNDING ASSIGNMENT
  128. NOTASG   CMP.W     #'R=',D0  ? ROUND SET
  129.          BNE.S     NOTRND    BRANCH NOT
  130.          BSR       INTRP     INTERPRET EXPRESSION
  131.          MOVE.L    D7,D1     SAVE FLOAT VALUE
  132.          BSR       IEFFPI    TO INTEGER
  133.          MOVE.L    D7,ROUND  SAVE ROUNDING FACTOR
  134.          MOVE.L    D1,D7     RESTORE FLOAT VALUE
  135.          BRA.S     CALPRNT   AND PRINT IT OUT
  136. NOTRND   LEA       (SP),A0   START SCAN AT FRONT
  137.          BSR       INTRP     INTERPRET EXPRESSION
  138.          BRA.S     CALPRNT   AND PRINT IT OUT
  139.  
  140. * DISPLAY RESULT BACK IN ASCII
  141. HEXTBL   DC.L      '0123456789ABCDEF'
  142.  
  143. CALPRNT  LEA       -8(SP),SP SETUP HEX TRANSLATE AREA
  144.          MOVE.L    #7,D0     LOOP 8 TIMES
  145.          MOVE.L    D7,D6     COPY FLOATING VALUE
  146. TOHEX    MOVE.B    D6,D1     TO NEXT FOUR BITS
  147.          AND.W     #%1111,D1 STRIP REST
  148.          MOVE.B    HEXTBL(D1),0(SP,D0) CONVERT TO HEX
  149.          LSR.L     #4,D6     TO NEXT HEX DIGIT
  150.          DBRA      D0,TOHEX  LOOP UNTIL DONE
  151.          MOVE.W    #'  ',-(SP) BLANK SEPERATOR
  152.          BSR       IEFFPA    BACK TO ASCII
  153.          MOVE.L    ROUND,D6  SETUP ROUNDING FACTOR
  154.          BSR       IEFARND   ROUND APPROPRIATLEY
  155.          LEA       (SP),A0   SETUP PUT
  156.          LEA       23(A0),A1 ARGUMENTS
  157.          MOVE.B    #$08,IOSBLK+3 FORCE UNFORMATTED MODE TO INHIBIT CR
  158.          BSR       PUT       SEND OUT RESULT OF CONVERSION
  159.          CLR.B     IOSBLK+3  TURN UNFORMATTED MODE BACK OFF
  160.          LEA       24(SP),SP DELETE WORK AREA
  161.          MOVE.W    CCRSAVE,CCR RESTORE CCR FOR BRANCH DISPLAY
  162.          BSR       DISPCCR   DISPLAY ALL BRANCH CONDITIONS VALID
  163.          BRA       INPUT     BACK FOR MORE
  164.  
  165. * INVALID RESPONSE - TARGET THE CHARACTER IN ERROR (A0->)
  166. ERRORSYN MOVE.L    A6,SP     RESTORE STACK BACK TO NORMAL
  167.          SUB.L     SP,A0     FIND OFFSET TO BAD CHARACTER
  168.          MOVE.L    A0,D0     PAD WITH BLANKS
  169. LOOP2PD  MOVE.B    #' ',0(SP,D0) BLANK OUT FRONT END
  170.          DBRA      D0,LOOP2PD LOOP UNTIL DONE
  171.          MOVE.B    #'^',0(SP,A0) SET POINTER
  172.          MOVE.B    #$0D,1(SP,A0) SET END OF LINE
  173.          LEA       1(SP,A0),A1 END OF TEXT
  174.          MOVE.L    SP,A0     START OF TEXT
  175.          BSR       PUT       PLACE OUT FLAG
  176.          BSR       MSG       SEND MESSAGE
  177.          DC.L      'SYNTAX'
  178.          BRA       INPUT
  179.  
  180.  
  181.  
  182. ****************************
  183. * INTERPRET THE EXPRESSION *
  184. * OUTPUT - D7              *
  185. * IF ERRORS OCCUR WILL NOT *
  186. * RETURN TO CALLER         *
  187. ****************************
  188.  
  189. INTRP    CMP.B     #$0D,(A0)           ? NULL EXPRESSION
  190.          BEQ       ERRORSYN            ***SYNTAX ERROR***
  191.          BSR.S     EVAL                EVAULATE AS AN EXPRESSION
  192.          CMP.B     #$0D,(A0)           ? EXPRESSION END AT THE CR
  193.          BNE       ERRORSYN            ***SYNTAX ERROR***
  194.          RTS                           RETURN TO CALLER
  195.  
  196. ****************************
  197. * SUB EXPRESSION EVALUATOR *
  198. *       SUBROUTINE         *
  199. * OUTPUT: D7 - RESULT      *
  200. *  IF ERRORS WILL NOT      *
  201. *  RETURN TO CALLER.       *
  202. ****************************
  203. EVAL     BSR       TERM      OBTAIN FIRST TERM
  204. EVALNXT  MOVE.W    CCR,CCRSAVE SAVE LAST FUNCTION CCR STATUS
  205.          MOVE.L    D7,-(SP)  SAVE FIRST ARGUMENT ON STACK
  206. * TEST FOR DIADIC OPERATOR AND ONE MORE TERM
  207.          MOVE.B    (A0)+,D0  LOAD NEXT CHARACTER
  208.          CMP.B     #'+',D0    ? ADD
  209.          BNE.S     NOTADD    BRANCH IF NOT
  210. *  "+" ADD OPERATOR
  211.          BSR.S     TERM      GET NEXT TERM
  212.          MOVE.L    (SP)+,D6  RELOAD ARG1 FOR ARG2
  213.          JSR       IEFADD    ADD THEM
  214.          BRA.S     EVALNXT   TRY FOR ANOTHER TERM
  215. NOTADD   CMP.B     #'-',D0    ? SUBTRACT
  216.          BNE.S     NOTSUB    BRANCH IF NOT
  217. *  "-" SUBTRACT OPERATOR
  218.          BSR.S     TERM      GET NEXT TERM
  219.          MOVE.L    (SP)+,D6  RELOAD ARG1
  220.          EXG.L     D6,D7     MUST SWAP FOR CORRECT ORDER
  221.          JSR       IEFSUB    SUBTRACT THEM
  222.          BRA.S     EVALNXT   TRY FOR ANOTHER TERM
  223. NOTSUB   CMP.B     #'*',D0    ? MULTIPLY
  224.          BNE.S     NOTMULT   BRANCH IF NOT
  225.          CMP.B     #'*',(A0) ? POWER FUNCTION
  226.          BNE.S     ISMULT    BRANCH NO, IS MULTIPLY
  227. *  "**" POWER OPERATOR
  228.          ADD.L     #1,A0     STRIP OFF SECOND ASTERISK
  229.          BSR.S     TERM      GET NEXT TERM
  230.          MOVE.L    (SP)+,D6  RELOAD BASE VALUE
  231.          EXG.L     D6,D7     SWAP FOR FUNCTION CALL
  232.          JSR       IEFPWR    PERFORM POWER FUNCTION
  233.          BRA.S     EVALNXT   TRY ANOTHER ITEM
  234. *  "*" MULTIPLY OPERATOR
  235. ISMULT   BSR.S     TERM      GET NEXT TERM
  236.          MOVE.L    (SP)+,D6  RELOAD ARG1
  237.          JSR       IEFMUL    MULTIPLY THEM
  238.          BRA.S     EVALNXT   TRY ANOTHER TERM
  239. NOTMULT  CMP.B     #'/',D0    ? DIVIDE
  240.          BNE.S     NOTDIV    BRANCH IF NOT DIVIDE
  241. *  "/" DIVIDE OPERATOR
  242.          BSR.S     TERM      GET NEXT TERM
  243.          MOVE.L    (SP)+,D6  RELOAD ARG1
  244.          EXG.L     D6,D7     SWAP ARGS (ARG2 INTO ARG1)
  245.          JSR       IEFDIV    DIVIDE THEM
  246.          BRA       EVALNXT   TRY FOR ANOTHER TERM
  247. NOTDIV   CMP.B     #'?',D0   ? TEST FOR COMPARE OPERATOR
  248.          BNE.S     EXPRTN    RETURN IF NOT
  249. *  "?" COMPARISON OPERATOR
  250.          BSR.S     TERM      GET NEXT TERM
  251.          MOVE.L    (SP)+,D6  RESTORE FIRST ARGUMENT
  252.          JSR       IEFCMP    DO IEEE FORMAT COMPARISON
  253.          BSR       DISPCMP   DISPLAY CCR FOR COMPARISON
  254.          MOVE.L    A6,SP     RESTORE STACK TO TOP LEVEL
  255.          BRA       INPUT     AND PERFORM NEXT REQUEST
  256.  
  257. EXPRTN   SUB.L     #1,A0     BACK TO CURRENT POSITION
  258.          MOVE.L    (SP)+,D7  RESTORE UNUSED ARGUMENT
  259.          RTS                 RETURN TO CALLER
  260.  
  261.  
  262. *************************
  263. * OBTAIN A TERM (VALUE) *
  264. *  OUTPUT: D7 - VALUE   *
  265. *          V - OVERFLOW *
  266. * WILL NOT RETURN TO    *
  267. * CALLER IF ERROR       *
  268. *************************
  269. * SCAN FUNCTION TABLE FOR MATCH
  270. TERM     LEA       FNCTNTBL,A1 SETUP TABLE ADDRESS
  271.          MOVE.L    #NUMFUN,D1 COUNT TABLE ENTRIES
  272. FNCNXT   MOVE.W    (A1)+,D2  PREPARE COMPARE LENGTH
  273.          MOVE.L    A1,A2     PREPARE ENTRY STRING POINTER
  274.          MOVE.L    A0,A3     WITH INPUT SCAN STRING
  275. FNCMPR   CMP.B     (A2)+,(A3)+ ? STILL VALID MATCH
  276.          DBNE      D2,FNCMPR LOOP IF SO
  277.          BEQ.S     GOTFUNC   BRANCH FOR MATCH
  278.          LEA       12(A1),A1 TO NEXT ENTRY POSITION
  279.          DBRA      D1,FNCNXT LOOP IF MORE TO CHECK
  280.          BRA       NOTFUNC   BRANCH NOT A FUNCTION
  281.  
  282. GOTFUNC  MOVE.L    8(A1),-(SP) SAVE ENTRY POINT ADDRESS
  283.          MOVE.L    A3,A0     BUMP SCAN TO AFTER PAREN
  284.          BSR       EVAL      OBTAIN INSIDE EXPRESSION
  285.          MOVE.L    (SP)+,A1  LOAD FUNCTION ROUTINE ADDRESS
  286.          JSR       (A1)      CALL APPROPRIATE ROUTINE
  287.          SUBA.W   #2,A7      CLEAR SPOT FOR CCR
  288.          MOVEM.L  D0,-(SP)   PUSH D0 ON STACK
  289.          SF       D0         CLR.B D0 W/O CHANGING CCR
  290.          BNE.S    CCZ        CHECK Z BIT,BRANCH IF CLR
  291.          BSET     #6,D0      SET BIT 6 TO 1 FOR Z BIT
  292. CCZ      BCC.S    CCC        CHECK C BIT,BRANCH IF CLR
  293.          BSET     #4,D0      SET BIT 4 TO 1 FOR C BIT
  294. CCC      BVC.S    CCV        CHECK V BIT,BRANCH IF CLR
  295.          BSET     #5,D0      SET BIT 5 TO 1 FOR V BIT
  296. CCV      BPL.S    CCN        CHECK N BIT,BRANCH IF CLR
  297.          BSET     #7,D0      SET BIT 7 TO 1 FOR N BIT
  298. CCN      ROXR.B   #4,D0      ROTATE X BIT IN
  299.          AND.W    #$1F,D0    CLEAR UPPER BYTE
  300.          MOVE.W   D0,4(SP)   SAVE CCR OF RESULT ON THE STACK
  301.          MOVE.L   (SP)+,D0   RESTORE OLD D0 VALUE
  302.          CMP.B     #')',(A0)+  ARE THEY?
  303.          BNE       ERRORSYN  BRANCH SYNTAX ERROR IF NOT
  304.          RTR                 RETURN WITH CONDITION CODE
  305.  
  306. * FUNCTION TABLE
  307. FNCTNTBL DC.W      0                   VANILLA PARENTHESIS
  308.          DC.L      '(       ',FPAREN
  309.          DC.W      4                   SQUARE ROOT
  310.          DC.L      'SQRT(   ',IEFSQRT
  311.          DC.W      3                   SINE
  312.          DC.L      'SIN(    ',IEFSIN
  313.          DC.W      3                   COSINE
  314.          DC.L      'COS(    ',IEFCOS
  315.          DC.W      3                   TANGENT
  316.          DC.L      'TAN(    ',IEFTAN
  317.          DC.W      3                   EXPONENT
  318.          DC.L      'EXP(    ',IEFEXP
  319.          DC.W      3                   LOGORITHM
  320.          DC.L      'LOG(    ',IEFLOG
  321.          DC.W      4                   ARCTANGENT
  322.          DC.L      'ATAN(   ',IEFATAN
  323.          DC.W      4                   HYPERBOLIC SINE
  324.          DC.L      'SINH(   ',IEFSINH
  325.          DC.W      4                   HYPERBOLIC COSINE
  326.          DC.L      'COSH(   ',IEFCOSH
  327.          DC.W      4                   HYPERBOLIC TANGENT
  328.          DC.L      'TANH(   ',IEFTANH
  329.          DC.W      3                   TST
  330.          DC.L      'TST(    ',IEFTST
  331.          DC.W      3                   NEGATE
  332.          DC.L      'NEG(    ',IEFNEG
  333.          DC.W      3                   ABSOLUTE VALUE
  334.          DC.L      'ABS(    ',IEFABS
  335.          DC.W      3                   INT (INTEGER CONVERT)
  336.          DC.L      'INT(    ',FINT
  337.  
  338. NUMFUN   EQU       (*-FNCTNTBL)/12
  339.  
  340. * PARENTHESIS EXPRESSION
  341. FPAREN   RTS       NO FUNCTION REQUIRED
  342.  
  343. * INTEGER CONVERT
  344. FINT     MOVE.L    D7,-(SP)  SAVE ORIGINAL ARGUMENT
  345.          JSR       IEFFPI    CONVERT TO INTEGER
  346.          BVC.S     FINTOK    BRANCH NOT NAN OR OVERFLOW
  347. * OVERFLOW OR NAN, EITHER CASE IS PROPERLY HANDLED BY RETURNING THE ORIGINAL
  348.          MOVE.L    (SP)+,D7  RELOAD ORIGINAL ARGUMENT
  349.          JSR       IEFTST    AND SET PROPER CCR
  350.          RTS                 RETURN TO CALLER
  351. FINTOK   JSR       IEFIFP    BACK TO FLOAT
  352.          ADD.L     #4,SP     RID SAVED ARGUMENT FROM STACK
  353.          RTS                 RETURN TO CALLER
  354.  
  355. * TEST FOR VARIABLES OR INFIX + AND -
  356. NOTFUNC  MOVE.B    (A0)+,D0  LOAD NEXT CHARACTER
  357.          MOVE.L    X,D7      DEFAULT TO X
  358.          CMP.B     #'X',D0   IS IT?
  359.          BEQ.S     TERMRTN   RETURN IF SO
  360.          MOVE.L    Y,D7      DEFAULT TO Y
  361.          CMP.B     #'Y',D0   ? IS IT
  362.          BEQ.S     TERMRTN   RETURN IF SO
  363.          CMP.B     #'+',D0    TEST PLUS
  364.          BEQ       NOTFUNC   BR YES TO SKIP IT
  365.          CMP.B     #'-',D0    INFIX MINUS
  366.          BNE.S     NOTMINUS  NO, TRY SOMTHING ELSE
  367. * IF THIS IS A NEGATIVE ASCII VALUE, WE MUST LET IT BE CONVERTED SINCE
  368. * A POSITIVE VALUE HAS LESS RANGE THAN A NEGATIVE ONE
  369.          CMP.B     #'.',(A0)  ? NUMERIC ASCII FOLLOWS
  370.          BEQ.S     NOTMINUS  YES, LET CONVERSION HANDLE IT PROPERLY
  371.          CMP.B     #'0',(A0)  ? ASCII NUMBER
  372.          BLS.S     DONEG     NOPE, COMPLEMENT THE FOLLOWING VALUE
  373.          CMP.B     #'9',(A0)  ? ASCII NUMBER
  374.          BLS.S     NOTMINUS   YEP, ALLOW PROPER CONVERSION
  375. DONEG    BSR       TERM      OBTAIN TERM
  376.          JSR       IEFNEG    NEGATE THE RESULT
  377. TERMRTN  RTS                 RETURN TO CALLER
  378.  
  379. * CHECK FOR DIRECT HEXADECIMAL SPECIFICATION
  380. NOTMINUS CMP.B     #'$',D0   ? HEXADECIMAL HERE
  381.          BNE.S     NOTHEX    BRANCH IF NOT
  382.          CLR.L     D7        START BUILDING THE VALUE
  383. PRSHEX   MOVE.B    (A0),D0   LOAD NEXT CHARACTER
  384.          CMP.B     #'0',D0   ? LESS THAN ASCII ZERO
  385.          BCS.S     TERMRTN   RETURN WITH RESULT IN D7 IF SO
  386.          CMP.B     #'9',D0   ? GREATER THAN NINE
  387.          BLS.S     GOTHEX    BRANCH NOT, IS A VALID DECIMAL DIGIT
  388.          CMP.B     #'A',D0   ? LESS THAN ASCII "A"
  389.          BCS.S     TERMRTN   RETURN RESULT IF NOT HEX DIGIT
  390.          CMP.B     #'F',D0   ? GREATER THAN "F"
  391.          BHI.S     TERMRTN   RETURN RESULT IF NOT HEX DIGIT
  392.          ADD.B     #9,D0     RE-MAP INTO BINARY RANGE
  393. GOTHEX   ADD.L     #1,A0     BUMP PAST THIS CHARACTER
  394.          AND.B     #$F,D0    ISOLATE HEX DIGIT
  395.          CMP.L     #$0FFFFFFF,D7 ? WILL ANOTHER DIGIT OVERFLOW
  396.          BHI       ERRORSYN  YES, BRANCH FOR SYNTAX ERROR
  397.          LSL.L     #4,D7     SHIFT OVER SAFELY FOR NEXT DIGIT
  398.          OR.B      D0,D7     OR NEW DIGIT IN LOW BYTE
  399.          BRA.S     PRSHEX    GO PARSE ANOTHER HEX DIGIT
  400.  
  401. * SEE IF 'NANX' SPECIFIC NAN DESIRED HERE
  402. NOTHEX   CMP.B     #'N',D0   ? NAN POSSIBLE
  403.          BNE.S     NOTNAN    NOPE
  404.          CMP.B     #'A',(A0) ? 'A' OF NAN
  405.          BNE.S     NOTNAN    NOPE
  406.          CMP.B     #'N',1(A0) ? 'N' OF NAN
  407.          BNE.S     NOTNAN    NOPE
  408.          CMP.B     #'0',2(A0) ? VALID NUMERIC ASCII
  409.          BLS.S     NOTNAN    NOPE
  410.          CMP.B     #'9',2(A0) ? VALID HIGH END
  411.          BHI.S     NOTNAN    NOPE
  412.          ADD.L     #2,A0     SKIP TO NUMBER
  413.          MOVE.L    #EXPMSK,D7 PREPARE NAN FORMAT - EXPONENT ALL ONES
  414.          MOVE.B    (A0)+,D7  LOAD ASCII DIGIT INTO LOW BYTE
  415.          AND.B     #$0F,D7   CONVERT TO STRAIGHT BINARY
  416.          JSR       IEFTST    SET PROPER CONDITION CODES FOR THIS VALUE
  417.          RTS                 AND RETURN THIS AS OUR VALUE
  418.  
  419. * ATTEMPT TO TREAT IT AS AN ASCII NUMBER
  420. NOTNAN   SUB.L     #1,A0     ATTEMPT ASCII INPUT VALUE
  421.          JSR       IEFAFP    ATTEMPT ASCII TO FLOAT
  422.          BCS       ERRORSYN  SYNTAX ERROR IF NO GOOD
  423.          RTS                 RETURN IF GOT VALUE
  424.  
  425. ************
  426. * END TEST *
  427. ************
  428. QUIT     BSR       MSG       ISSUE DONE MESSAGE
  429.          DC.L      '  DONE'
  430.          MOVE.L    #15,D0    TERMINATE TASK
  431.          TRAP      #1        HERE
  432.  
  433.  
  434. *   *
  435. *   * DISPLAY THE CCR BRANCH CONDITIONS SUBROUTINE
  436. *   *   EVERYTHING TRANSPARENT (INCLUDING CCR)
  437. *   *
  438.  
  439. * COMPARE ONLY DISPLAY ("C" ON FOR NANS)
  440. DISPCMP  SUBA.W   #2,A7      CLEAR SPOT FOR CCR
  441.          MOVEM.L  D0,-(SP)   PUSH D0 ON STACK
  442.          SF       D0         CLR.B D0 W/O CHANGING CCR
  443.          BNE.S    CCZ2       CHECK Z BIT,BRANCH IF CLR
  444.          BSET     #6,D0      SET BIT 6 TO 1 FOR Z BIT
  445. CCZ2     BCC.S    CCC2       CHECK C BIT,BRANCH IF CLR
  446.          BSET     #4,D0      SET BIT 4 TO 1 FOR C BIT
  447. CCC2     BVC.S    CCV2       CHECK V BIT,BRANCH IF CLR
  448.          BSET     #5,D0      SET BIT 5 TO 1 FOR V BIT
  449. CCV2     BPL.S    CCN2       CHECK N BIT,BRANCH IF CLR
  450.          BSET     #7,D0      SET BIT 7 TO 1 FOR N BIT
  451. CCN2     ROXR.B   #4,D0      ROTATE X BIT IN
  452.          AND.W    #$1F,D0    CLEAR UPPER BYTE
  453.          MOVE.W   D0,4(SP)   SAVE CCR OF RESULT ON THE STACK
  454.          MOVE.L   (SP)+,D0   RESTORE OLD D0 VALUE
  455.          BCC.S     CMPNNAN   BRANCH NO NAN DURING COMPARE
  456.          BSR       MSG       SHOW UNORDERED COMPARE
  457.          DC.L      'UNORDERD' EYE-CATCHER
  458.          RTR                 RETURN AND RESTORE CCR
  459. * SETUP ARITHMETIC RESULTS GT/LE GE/LT
  460. CMPNNAN  MOVE.W    (SP)+,CCR RESTORE CCR
  461.          MOVEM.L   D0-D1/A0-A1,-(SP) SAVE WORK REGISTERS
  462.          MOVE.W    CCR,D0     SAVE CCR IN D0
  463.          MOVE.L    SP,A1     STACK FRAME POINTER
  464.          MOVE.W    #'GT',-(SP) DEFAULT CONDITION
  465.          MOVE.W    D0,CCR    RESET CCR
  466.          BGT.S     DISPGT    BRANCH CORRECT
  467.          MOVE.W    #'LE',(SP) CHANGE
  468. DISPGT   MOVE.L    #'GE  ',-(SP) DEFAULT CONDITION
  469.          MOVE.W    D0,CCR    RESET CCR
  470.          BGE.S     DISPPL    BRANCH CORRECT
  471.          MOVE.W    #'LT',(SP) CHANGE
  472.          BRA.S     DISPPL    CONTINUE WITH EQ/NE TO FINISH DISPLAY
  473.  
  474. * REGULAR DISPLAY
  475. DISPCCR  MOVEM.L   D0-D1/A0-A1,-(SP) SAVE WORK REGISTERS ON THE STACK
  476.          MOVE.W    CCR,D0    SAVE CONDITION CODE REGISTER FOR TESTS
  477.          MOVE.L    SP,A1     STACK FRAME POINTER
  478. * TEST FOR NAN (V SET)
  479.          BVC.S     DISPGE    BRANCH NOT NAN
  480.          MOVE.L    #'MBER',-(SP) SETUP NAN EYE-CATCHER
  481.          MOVE.L    #'A-NU',-(SP) SETUP NAN EYE-CATCHER
  482.          MOVE.L    #'NOT-',-(SP) SETUP NAN EYE-CATCHER
  483. * SETUP TEST RESULTS: EQ/NE PL/MI
  484. DISPGE   MOVE.L    #'PL  ',-(SP)  DEFAULT CONDITION
  485.          MOVE.W    D0,CCR    RESET CCR
  486.          BPL.S     DISPPL    BRANCH CORRECT
  487.          MOVE.W    #'MI',(SP) CHANGE
  488. DISPPL   MOVE.L    #'EQ  ',-(SP)  DEFAULT CONDITION
  489.          MOVE.W    D0,CCR    RESET CCR
  490.          BEQ.S     DISPEQ    BRANCH CORRECT
  491.          MOVE.W    #'NE',(SP) CHANGE
  492. DISPEQ   MOVE.L    #'    ',-(SP) ADD BLANKS TO BEGINNING
  493.          MOVE.L    SP,A0     START OF STRING PRINT
  494.          SUB.L     #1,A1     POINT TO LAST CHARACTER
  495.          BSR.S     PUT       SEND STRING TO CONSOLE
  496.          LEA       1(A1),SP  RESTORE STACK BACK
  497.          MOVE.W    D0,CCR  RESTORE CCR
  498.          MOVEM.L   (SP)+,D0-D1/A0-A1 RESTORE REGISTERS
  499.          RTS                 RETURN TO CALLER
  500.  
  501. *   *
  502. *   * MSG SUBROUTINE
  503. *   *  INPUT: (SP) POINT TO EIGHT BYTE TEXT FOLLOWING BSR/JSR
  504. *   *
  505. MSG      MOVEM.L   D0/A0/A1,-(SP) SAVE REGS
  506.          MOVE.L    3*4(SP),A0 LOAD RETURN POINTER
  507.          LEA       7(A0),A1   POINT TO BUFFER END
  508.          BSR.S     PUT       ISSUE IOS CALL
  509.          MOVEM.L   (SP)+,D0/A0/A1 RELOAD REGISTERS
  510.          ADD.L     #8,(SP)   ADJUST RETURN ADDRESS
  511.          RTS                 RETURN TO CALLER
  512.  
  513. *   *
  514. *   * PUT SUBROUTINE
  515. *   *  INPUT: A0->TEXT START, A1->TEXT END
  516. *   *
  517. PUT      MOVEM.L   D0/A0/A1,-(SP) SAVE REGS
  518.          MOVEM.L   A0-A1,BUFPTR SETUP BUFFER POINTERS
  519.          SUB.L     A0,A1     COMPUTE LENGTH-1
  520.          LEA       1(A1),A1  ADD ONE
  521.          MOVE.L    A1,BUFLEN INSERT LENGTH
  522.          MOVE.B    #6,DEVICE TO OUTPUT STREAM
  523.          MOVE.B    #2,IOSBLK+1 AND WRITE FUNCTION
  524.          LEA       IOSBLK,A0  LOAD BLOCK ADDRESS
  525.          TRAP      #2        ISSUE IOS CALL
  526.          MOVEM.L   (SP)+,D0/A0/A1 RELOAD REGISTERS
  527.          RTS                 RETURN TO CALLER
  528.  
  529. *   *
  530. *   * GET SUBROUTINE
  531. *   *   INPUT: A0->BUFFER START, A1->LAST OF BUFFER
  532. *   *
  533. GET      MOVEM.L   D0/A0/A1,-(SP) SAVE REGS
  534.          MOVEM.L   A0-A1,BUFPTR PLACE BUFFER POINTERS
  535.          MOVE.B    #1,IOSBLK+1 PERFORM READ
  536.          MOVE.B    #5,DEVICE READ FROM INPUT DEVICE
  537.          LEA       IOSBLK,A0 LOAD PARAMETER
  538.          TRAP      #2        IOS CALL
  539.          MOVEM.L   (SP)+,D0/A0/A1 RESTORE REGISTERS
  540.          RTS                 RETURN TO CALLER
  541.  
  542. * IOS BLOCK FOR TERMINAL FORMATED SEND
  543. IOSBLK   DC.B     0,2,0,0    WRITE FORMATTED WAIT
  544.          DC.B     0
  545. DEVICE   DC.B     0,0,0
  546.          DC.L     0
  547. BUFPTR   DC.L      0,0
  548. BUFLEN   DC.L      0,0
  549.  
  550. * VARIABLES
  551. X        DC.L      0
  552. Y        DC.L      0
  553. CCRSAVE  DC.W      0
  554. ROUND    DC.L      -100      ROUNDING FACTOR
  555.  
  556. * STARTUP MESSAGES
  557. STRTM    DC.W      'FAST FLOATING POINT IEEE FORMAT EQUIVALENT DESK CALCULATOR'
  558. STRTME   DC.W      0
  559. STRTM2   DC.W      '            (C) COPYRIGHT 1981 BY MOTOROLA'
  560. STRTM2E  DC.W      0
  561.  
  562. * PROGRAM STACK
  563.          DCB.W     100,0      STACK AREA
  564. STACK    EQU       *
  565.  
  566.          END       IEFCALC
  567.  
  568.